MODULE SUSCST_MOD
CONTAINS
SUBROUTINE SUSCST(PRCORIOI,PRPLRG,YDCST)

USE PARKIND1 , ONLY : JPIM, JPRB
USE YOMHOOK  , ONLY : LHOOK, DR_HOOK, JPHOOK
USE YOS_CST  , ONLY : TCST

! (C) Copyright 2005- ECMWF.
!
! This software is licensed under the terms of the Apache Licence Version 2.0
! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
! In applying this licence, ECMWF does not waive the privileges and immunities
! granted to it by virtue of its status as an intergovernmental organisation
! nor does it submit to any jurisdiction.

!**   *SUSCST* IS THE SET-UP ROUTINE FOR COMMON BLOCK *YOS_CST*
!              This contains the fundamental model constants

!     INTERFACE.
!     ----------
!     CALL *SUSCST* FROM *SUSURF*

!     METHOD.
!     -------

!     EXTERNALS.
!     ----------

!     REFERENCE.
!     ----------

!     Original    P. Viterbo      May 2005
!        Based on the IFS sucst

!     Modified:  
!         P. Bechtold 26-03-2012: Add PRCORIO PRPLRG factor for small planet
!      F. Vana  05-Mar-2015  Support for single precision

IMPLICIT NONE
REAL(KIND=JPRB),INTENT(IN)    :: PRCORIOI, PRPLRG
TYPE(TCST)     ,INTENT(INOUT) :: YDCST

REAL(KIND=JPRB) :: ZRKBOL, ZRCLUM, ZRHPLA, ZRNAVO, ZRMD, ZRMV
REAL(KIND=JPRB) :: ZSIYEA, ZSIDAY

REAL(KIND=JPRB) :: ZCORIOI
REAL(KIND=JPHOOK) :: ZHOOK_HANDLE

!     ------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('SUSCST_MOD:SUSCST',0,ZHOOK_HANDLE)
ASSOCIATE(R=>YDCST%R, RATM=>YDCST%RATM, RCPD=>YDCST%RCPD, RCPV=>YDCST%RCPV, &
 & RD=>YDCST%RD, RDAY=>YDCST%RDAY, RETV=>YDCST%RETV, RG=>YDCST%RG, &
 & RLMLT=>YDCST%RLMLT, RLSTT=>YDCST%RLSTT, RLVTT=>YDCST%RLVTT, &
 & ROMEGA=>YDCST%ROMEGA, RPI=>YDCST%RPI, RSIGMA=>YDCST%RSIGMA, RTT=>YDCST%RTT, &
 & RV=>YDCST%RV)

!  DEFINE FUNDAMENTAL CONSTANTS.

RPI=2.0_JPRB*ASIN(1.0_JPRB)
ZRCLUM=299792458._JPRB
ZRHPLA=6.6260755E-34_JPRB
ZRKBOL=1.380658E-23_JPRB
ZRNAVO=6.0221367E+23_JPRB

!  DEFINE ASTRONOMICAL CONSTANTS.
RDAY=86400._JPRB
IF (PRCORIOI .NE. 0.0_JPRB) THEN
RDAY=86400._JPRB*PRCORIOI
ENDIF
ZSIYEA=365.25_JPRB*RDAY*2.0_JPRB*RPI/6.283076_JPRB
ZSIDAY=RDAY/(1.0_JPRB+RDAY/ZSIYEA)
IF (PRCORIOI .NE. 0.0_JPRB) THEN
ROMEGA=2.0_JPRB*RPI/ZSIDAY
ELSE
ROMEGA=0.0_JPRB
ENDIF
!  DEFINE GEOIDE.

RG=9.80665_JPRB*PRPLRG

!  DEFINE RADIATION CONSTANTS.

!RSIGMA=2.0_JPRB * RPI**5 * ZRKBOL**4 /(15._JPRB* ZRCLUM**2 * ZRHPLA**3)
RSIGMA=2.0_JPRB * RPI**5 * (ZRKBOL/ZRHPLA)**3 * ZRKBOL /(15._JPRB* ZRCLUM**2)

!  DEFINE THERMODYNAMIC CONSTANTS, GAS PHASE.

R=ZRNAVO*ZRKBOL
ZRMD=28.9644_JPRB
ZRMV=18.0153_JPRB
RD=1000._JPRB*R/ZRMD
RV=1000._JPRB*R/ZRMV
RCPD=3.5_JPRB*RD
RCPV=4._JPRB *RV
RETV=RV/RD-1.0_JPRB

!  DEFINE THERMODYNAMIC CONSTANTS, TRANSITION OF PHASE.

RTT=273.16_JPRB
RLVTT=2.5008E+6_JPRB
RLSTT=2.8345E+6_JPRB
RLMLT=RLSTT-RLVTT
RATM=100000._JPRB

END ASSOCIATE
IF (LHOOK) CALL DR_HOOK('SUSCST_MOD:SUSCST',1,ZHOOK_HANDLE)

!     ------------------------------------------------------------------

END SUBROUTINE SUSCST
END MODULE SUSCST_MOD
